package Net::IDN::Util;

# $Id: Util.pm 13299 2007-07-02 12:46:59Z gr $

# Package holding various useful functions.

use warnings;
use strict;
use Error ':try';

our $VERSION = '1.05';

use base 'Exporter';

our %EXPORT_TAGS = (
    util => [ qw/
        punycode_to_utf8 utf8_to_printable ace_to_utf8 utf8_to_ace
        eutf8_to_ace
    / ],
);

our @EXPORT_OK = @{ $EXPORT_TAGS{all} = [ map { @$_ } values %EXPORT_TAGS ] };


sub punycode_to_utf8 {
    require IDNA::Punycode;
    my $utf8 = IDNA::Punycode::decode_punycode(+shift);
    utf8::upgrade($utf8);
    $utf8;
}


# the kludge with "\\x{"."%04X}" is necessary so it's not a template start tag

sub utf8_to_printable {
    join("",
        map { $_ > 255                  # if wide character...
        ? sprintf("\\x{"."%04X}", $_)   # \x{...}
        : chr($_) =~ /[[:cntrl:]]/      # else if control character ...
          ? sprintf("\\x%02X", $_)      # \x..
          : chr($_)                     # else as themselves
    } unpack("U*", $_[0]));             # unpack Unicode characters
}


sub ace_to_utf8 {
    my $value = shift;
    my $utf8_domain;
    try {
        $utf8_domain = join '.',
            map { punycode_to_utf8($_) } split /\./, $value;
    } catch Error with {
        # Invalid ACE string? do nothing; we'll just leave $utf8_domain as
        # undef
    };
    $utf8_domain;
}


sub utf8_to_ace {
    my $value = shift;

    require IDNA::Punycode;

    return
        join '.' =>
        map {
            my $ace = IDNA::Punycode::encode_punycode($_);

            # encode_punycode turns a normal ascii string of 'xyz' into
            # 'xyz-', so in that case we'd like to retain the original
            # string (this is about domain names after all and we decide
            # what's right and what's not). We need to manually prepend
            # 'xn--' as well.
            #
            # There seems to be a problem when the utf8 string ends in a
            # dash, though - but we don't allow such domain names anyway.

            if ($ace eq "$_-") {
                $_
            } else {
                $ace
            }
        }
        split /\./ => $value;
}


# Converts an enhanced UTF-8 string to ACE. Enhanced in this case means a
# perl-like way of entering Unicode characters, such as \x{...} and \N{...}.
#
# Examples:
#
# eutf2ace gr\N{LATIN SMALL LETTER U WITH DIAERESIS}nauer.at
# eutf2ace gr\x{fc}nauer.at

sub eutf8_to_ace {
    local $_ = shift;  # the enhanced UTF-8 domain name
    require charnames;
    s/\\x{([0-9a-f]+)}/chr(hex($1))/ige;
    s/\\N{(.*?)}/chr(charnames::vianame(uc $1))/ige;
    utf8_to_ace($_);
}


1;


__END__

{% USE p = PodGenerated %}

=head1 NAME

{% p.package %} - Utility functions for IDN handling

=head1 SYNOPSIS

    {% p.package %}->new;

=head1 DESCRIPTION

None yet.

{% PROCESS standard_pod %}

=cut

